!! Copyright (C) 2009,2010,2011,2012  Marco Restelli
!!
!! This file is part of:
!!   FEMilaro -- Finite Element Method toolkit
!!
!! FEMilaro is free software; you can redistribute it and/or modify it
!! under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 3 of the License, or
!! (at your option) any later version.
!!
!! FEMilaro is distributed in the hope that it will be useful, but
!! WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
!! General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with FEMilaro; If not, see <http://www.gnu.org/licenses/>.
!!
!! author: Marco Restelli                   <marco.restelli@gmail.com>

!>\brief
!! Additional variables useful for profiling OpenMP programs. 
!!
!! \n
!!
!! This module can be used to time a generic OpenMP construct as
!! follows (some function calls can be omitted):
!! \code
!!  !$ if(detailed_timing_omp) then
!!  !$   call omput_push_key(<key>)
!!  !$   call omput_start_timer()
!!  !$ endif
!!  <ANY_OMP_CONSTRUCT>
!!  !$ if(detailed_timing_omp) then
!!  !$   call omput_write_time()
!!  !$   call omput_close_timer()
!!  !$   call omput_pop_key()
!!  !$ endif
!! \endcode
!! where <tt><key></tt> is an identifier for each OpenMP section. The
!! timings can be collected with \c collect_OMP_data.m.
!!
!! To distinguish calls to a specific OMP construct made from
!! different contexts, this module uses stacks for the timers and the
!! identifiers used in the output.
!!
!! A new timer can be started with \c omput_start_timer and closed
!! with \c omput_close_timer, and \c omput_write_time always refer to
!! the topmost active timer. Each call to \c omput_start_timer must be
!! matched by a call to \c omput_close_timer.
!!
!! To include a new key in the output identifier, use \c
!! omput_push_key, and afterward remove the key from the stack with \c
!! omput_pop_key. Each call to \c omput_push_key must be matched by a
!! call to \c omput_pop_key.
!<----------------------------------------------------------------------
module mod_omp_utils

!-----------------------------------------------------------------------

 use omp_lib

 use mod_messages, only: &
   mod_messages_initialized, &
   error,   &
   warning, &
   info

!-----------------------------------------------------------------------
 
 implicit none

!-----------------------------------------------------------------------

! Module interface

 public :: &
   mod_omp_utils_constructor, &
   mod_omp_utils_destructor,  &
   mod_omp_utils_initialized, &
   detailed_timing_omp, &
   omput_push_key,      &
   omput_pop_key,       &
   omput_start_timer,   &
   omput_close_timer,   &
   omput_write_time

 private

!-----------------------------------------------------------------------

! Module types and parameters

 ! public members
 !logical, parameter :: detailed_timing_omp = .false.
 logical, parameter :: detailed_timing_omp = .true.
 logical, protected ::               &
   mod_omp_utils_initialized = .false.

 ! private members
 integer, parameter ::          &
   ntimers_max    = 1000,       &
   nkeys_max      = 100,        &
   key_max_length = 1000
 character(len=*), parameter :: &
   prefix_omp_out = '$OMP '
 character(len=*), parameter :: &
   tform_omp      = '(A,F9.4)'

 integer :: ntimers, nkeys, istart(0:nkeys_max), iend(0:nkeys_max)
 double precision :: &
   timers(ntimers_max)
 character(len=len(prefix_omp_out)+nkeys_max*(1+key_max_length)) :: &
   key_stack
 character(len=*), parameter :: &
   this_mod_name = 'mod_omp_utils'

!-----------------------------------------------------------------------

contains

!-----------------------------------------------------------------------

 subroutine mod_omp_utils_constructor()
  character(len=*), parameter :: &
    this_sub_name = 'constructor'

   !Consistency checks ---------------------------
   if( (mod_messages_initialized.eqv..false.) ) then
     call error(this_sub_name,this_mod_name, &
                'Not all the required modules are initialized.')
   endif
   if(mod_omp_utils_initialized.eqv..true.) then
     call warning(this_sub_name,this_mod_name, &
                  'Module is already initialized.')
   endif
   !----------------------------------------------

   nkeys = 0
   iend(nkeys) = len(prefix_omp_out)
   key_stack(1:iend(nkeys)) = prefix_omp_out

   mod_omp_utils_initialized = .true.
 end subroutine mod_omp_utils_constructor

!-----------------------------------------------------------------------
 
 subroutine mod_omp_utils_destructor()
  character(len=*), parameter :: &
    this_sub_name = 'destructor'
   
   !Consistency checks ---------------------------
   if(mod_omp_utils_initialized.eqv..false.) then
     call error(this_sub_name,this_mod_name, &
                'This module is not initialized.')
   endif
   !----------------------------------------------

   mod_omp_utils_initialized = .false.
 end subroutine mod_omp_utils_destructor

!-----------------------------------------------------------------------

 subroutine omput_push_key(key)
  character(len=*), intent(in) :: key

  character(len=*), parameter :: &
    this_sub_name = 'omput_push_key'

   if(nkeys.eq.nkeys_max) &
     call error(this_sub_name,this_mod_name,'The key stack is full.')
   if(len_trim(key).gt.key_max_length) &
     call error(this_sub_name,this_mod_name,'The key is too long.')

   istart(nkeys+1) = iend(nkeys)+1
   iend(nkeys+1) = istart(nkeys+1) + len_trim(key)
   nkeys = nkeys + 1

   key_stack(istart(nkeys):iend(nkeys)) = trim(key)//':'

 end subroutine omput_push_key

!-----------------------------------------------------------------------
 
 subroutine omput_pop_key()
  character(len=*), parameter :: &
    this_sub_name = 'omput_pop_key'

   if(nkeys.eq.0) &
     call error(this_sub_name,this_mod_name,'The key stack is empty.')

   key_stack(istart(nkeys):iend(nkeys)) = ''
   nkeys = nkeys-1
 
 end subroutine omput_pop_key
 
!-----------------------------------------------------------------------
 
 subroutine omput_start_timer()
  character(len=*), parameter :: &
    this_sub_name = 'omput_start_timer'

   if(ntimers.eq.ntimers_max) &
     call error(this_sub_name,this_mod_name,'The timer stack is full.')

   ! start the new timer
   ntimers = ntimers+1
   timers(ntimers) = omp_get_wtime()
 
 end subroutine omput_start_timer
 
!-----------------------------------------------------------------------
 
 subroutine omput_close_timer()
  character(len=*), parameter :: &
    this_sub_name = 'omput_close_timer'
 
   if(ntimers.eq.0) &
     call error(this_sub_name,this_mod_name,'The timer stack is empty.')

   ntimers = ntimers-1

 end subroutine omput_close_timer
 
!-----------------------------------------------------------------------
 
 subroutine omput_write_time()
  double precision :: dt
  character(len=*), parameter :: &
    this_sub_name = 'omput_write_time'

   if(ntimers.eq.0) &
     call error(this_sub_name,this_mod_name,'The timer stack is empty.')

   dt = omp_get_wtime() - timers(ntimers)
   write(*,tform_omp) key_stack(1:iend(nkeys)) , dt
 
 end subroutine omput_write_time
 
!-----------------------------------------------------------------------

end module mod_omp_utils

